home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / IPC / File Mappings / API / ChildMainFormUnit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-28  |  1.9 KB  |  83 lines
  1. unit ChildMainFormUnit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Memo1: TMemo;
  12.     procedure FormCreate(Sender: TObject);
  13.     procedure FormDestroy(Sender: TObject);
  14.     procedure Memo1Change(Sender: TObject);
  15.   private
  16.     { Private declarations }
  17.   public
  18.     MemMapFile: THandle;
  19.     MemMapFileBuffer: Pointer;
  20.   end;
  21.  
  22. {$ifdef Ver90}
  23.   //This exception class did not exist in Delphi 2
  24.   EWin32Error = class(Exception);
  25. {$endif}
  26.  
  27. var
  28.   Form1: TForm1;
  29.  
  30. const
  31.   MemMapFileName = 'SampleMemoryMappedFile';
  32.   MemMapSize = 1000;
  33.  
  34. implementation
  35.  
  36. {$R *.DFM}
  37.  
  38. {$ifdef Ver90}
  39. //This function class did not exist in Delphi 2
  40. function Win32Check(RetVal: Bool): Bool;
  41. var
  42.   LastError: DWord;
  43. begin
  44.   Result := RetVal;
  45.   if not RetVal then
  46.   begin
  47.     LastError := GetLastError;
  48.     if LastError <> Error_Success then
  49.       raise EWin32Error.CreateFmt( 'Win32 Error.  Code: %d.'#10'%s',
  50.         [LastError, SysErrorMessage(LastError)])
  51.     else
  52.       raise EWin32Error.Create('A Win32 API function failed')
  53.   end;
  54. end;
  55. {$endif}
  56.  
  57. procedure TForm1.FormCreate(Sender: TObject);
  58. begin
  59.   //$FFFFFFFF causes CreateFileMapping to make a shared
  60.   //memory-mapped file which is stored, if
  61.   //it becomes necessary, in the OS swap file
  62.   MemMapFile := CreateFileMapping($FFFFFFFF, nil, Page_ReadWrite, 0,
  63.     MemMapSize, MemMapFileName);
  64.   Win32Check(Bool(MemMapFile));
  65.   MemMapFileBuffer := MapViewOfFile(MemMapFile, File_Map_Write, 0, 0, MemMapSize);
  66.   Win32Check(Bool(MemMapFileBuffer));
  67. end;
  68.  
  69. procedure TForm1.FormDestroy(Sender: TObject);
  70. begin
  71.   CloseHandle(MemMapFile)
  72. end;
  73.  
  74. procedure TForm1.Memo1Change(Sender: TObject);
  75. var
  76.   Msg: String;
  77. begin
  78.   Msg := Memo1.Text;
  79.   Move(PChar(Msg)^, MemMapFileBuffer^, Length(Msg) + 1)
  80. end;
  81.  
  82. end.
  83.